Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/zlogo2.pas

Pascal/Delphi Source File | 1994-07-25 | 4.6 KB | 271 lines

program logo1;
{
  Zoom Logo #2
  - by Bjarke Viksφe
  jun 1994

  THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.

  Doing zooms quite a lot faster than version 1.
  Why? Because of word write to VGA memory!
  Could easily be modifyed to zoom any factor... some other day
}

(*{$DEFINE DEBUG}*)

uses
    DEMOINIT,ILBM256;

type
    SlopeArray = array[0..320] of integer;

var
    buffer,tempscreen : pScreen;
    slope : SlopeArray;
    otherslope : SlopeArray;
    y320tabel : array[0..HEIGHT] of word;

    xpos,ypos,xsize,ysize : integer;

const
    display1 : word = $0000;
    display2 : word = $4000;
    display3 : word = $8000;


(*------------------------------------------------*)

procedure InitDemo;
var
    i : integer;
begin
    Screen_Off;
    FadeCMAP(0);
    ClearWholeScreen;

    xsize:=120;
    ysize:=2;
    xpos:=160-(xsize DIV 2);
    ypos:=100-(ysize DIV 2);

    for i:=0 to HEIGHT do y320tabel[i]:=i*320;

    New(buffer);
    New(tempscreen);
    LoadPix(buffer,'PARASIT1.LBM');
    MakeTweak(buffer,tempscreen);
    SetCMAP;
    Screen_On;
end;

procedure UninitDemo;
var
    i : integer;
begin
    Dispose(buffer);
    Dispose(tempscreen);
end;


(*------------------------------------------------*)

procedure SwapDisplay;
var
    temp : word;
begin
    temp:=display3;
    display2:=display1;
    display3:=display2;
    display1:=temp;
    SetAddress(Ptr(SEGA000,display3));
end;


(*------------------------------------------------*)

procedure CalcSlope(x1,x2,ysize : integer); assembler;
{ yes, we precalc both horizontal and vertical scaling array.
  Some of u might think this is slow, but who cares!}
asm
    lea    si,slope
    mov    ax,x1
    mov    cx,x2
    mov    dx,ysize

    push    ax
    sub    cx,ax
    inc    cx

    and    dx,dx
    jz        @zero

    cmp    dx,1
    jne    @not1
    dec    cx
    mov    dx,cx
    xor    ax,ax
    jmp    NEAR PTR @one
@not1:
    cmp    dx,2
    jne    @not2
    mov    ax,$7FFF
    imul    cx
    jmp    NEAR PTR @one
@not2:

    mov    dx,$0001
    mov    ax,$0000
    idiv    ysize
    imul    cx
@one:
    pop    cx
    xor    bx,bx

    inc    ysize
    mov    di,ysize
@loop:
    mov    [si],cx
    add    si,2
    add    bx,ax
    adc    cx,dx
    dec    di
    jnz    @loop
@zero:
end;


(*------------------------------------------------*)

procedure ZoomLine(xpos,ysize,dst_offset : word); assembler;
asm
    mov    es,SEGA000
    mov    di,dst_offset
    add    di,display1
    mov    ax,WORD PTR buffer+2
    {mov fs,ax} DB $8E,$E0
    mov    dx,xpos
    add    dx,WORD PTR buffer
    lea    si,slope
    mov    cx,ysize
    cld
@yloop:
    lodsw
    add    ax,dx
    mov    bx,ax
    DB FS; mov    al,[bx]
    mov    [es:di],al
    add    di,WIDTH
    dec    cl
    jnz    @yloop
end;

procedure Zoom2Lines(xpos1,xpos2,ysize,dst_offset : word); assembler;
{this same is the above - only it takes a word instead of a single byte
 Speeds up things a bit on slow vga-cards [like mine :-( ]}
asm
    push    bp {zooms two pixel in tweak-mode - so eg pixel 0 and 3 ...}
    mov    es,SEGA000
    mov    di,dst_offset
    add    di,display1
    mov    ax,WORD PTR buffer+2
    {mov fs,ax} DB $8E,$E0
    mov    dx,xpos1
    add    dx,WORD PTR buffer

    mov    cx,ysize

    mov    ax,xpos2
    sub    ax,xpos1
    mov    bp,ax

    lea    si,slope
    cld
@yloop:
    lodsw
    add    ax,dx
    mov    bx,ax
    DB FS; mov    al,[bx]
    add    bx,bp
    DB FS; mov    ah,[bx]
    mov    [es:di],ax
    add    di,WIDTH
    dec    cl
    jnz    @yloop
    pop    bp
end;


(*------------------------------------------------*)


procedure RunOnce;
var
    i,j : integer;
    dst_offset : word;
begin
    SwapDisplay;
{$IFNDEF DEBUG}
    while retraces=0 do ;
    retraces:=0;
{$ELSE}
    VBLANK;
    SetRGB(0,30,0,0);
{$ENDIF}

    CalcSlope(0,319,xsize);
    otherslope:=slope;
    CalcSlope(0,199,ysize);
    for i:=0 to ysize do slope[i]:=y320tabel[slope[i]];

    dst_offset:=longmul(ypos,WIDTH)+(xpos shr 2);
    j:=0;
    i:=xpos;

    {zoom first byte if we are on an odd address}
    while (i < xpos+xsize) AND odd(dst_offset) do begin
        SetBitplanes(1 shl (i AND 3));
        ZoomLine(otherslope[j],ysize,dst_offset);
        inc(j);
        inc(i); if ((i AND 3)=0) then inc(dst_offset);
    end;

    {zoom rest of picture in words}
    while (i < xpos+xsize) do begin
        SetBitplanes(1 shl (i AND 3));
        Zoom2Lines(otherslope[j],otherslope[j+4],ysize,dst_offset);
        inc(j);
        inc(i);
        if ((i AND 3)=0) then begin
            inc(i,4);
            inc(j,4);
            inc(dst_offset,2);
        end;
    end;

    {NOTICE: last pixel row (byte) may be skipped in some zooms!}

    if (xpos>0) AND (ypos>0) then begin
        {get new zoom-values}
        dec(xpos);
        dec(ypos);
        inc(xsize,2);
        inc(ysize,2);
    end;
{$IFDEF DEBUG}
    SetRGB(0,0,0,0);
{$ENDIF}
end;


begin
    OpenScreen;
    InitDemo;
    SetAllInterrupts;
    repeat RunOnce until Key='e';
    RestoreAllInterrupts;
    UninitDemo;
    CloseScreen;
end.